Escriba aquí de qué se trató el control y sus principales hallazgos de los resultados que usted obtuvo respondiendo a las preguntas.
#install.packages("chilemapas")
#install.packages("rgdal")
#install.packages('sf')
library(rgdal)
## Loading required package: sp
## rgdal: version: 1.3-6, (SVN revision 773)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 2.1.3, released 2017/20/01
## Path to GDAL shared files: /Library/Frameworks/R.framework/Versions/3.5/Resources/library/rgdal/gdal
## GDAL binary built with GEOS: FALSE
## Loaded PROJ.4 runtime: Rel. 4.9.3, 15 August 2016, [PJ_VERSION: 493]
## Path to PROJ.4 shared files: /Library/Frameworks/R.framework/Versions/3.5/Resources/library/rgdal/proj
## Linking to sp version: 1.3-1
library(sp)
library(chilemapas)
## Loading required package: sf
## Linking to GEOS 3.7.2, GDAL 2.4.2, PROJ 5.2.0
library(data.table)
library(ggplot2)
covid<-fread(input ="output/producto2/2020-04-20-CasosConfirmados.csv")
str(covid)
## Classes 'data.table' and 'data.frame': 346 obs. of 6 variables:
## $ Region : chr "Arica y Parinacota" "Arica y Parinacota" "Arica y Parinacota" "Arica y Parinacota" ...
## $ Codigo region : int 15 15 15 15 1 1 1 1 1 1 ...
## $ Comuna : chr "Arica" "Camarones" "General Lagos" "Putre" ...
## $ Codigo comuna : int 15101 15102 15202 15201 1107 1402 1403 1404 1101 1405 ...
## $ Poblacion : num 247552 1233 810 2515 129999 ...
## $ Casos Confirmados: num 166 0 0 0 27 0 0 0 36 28 ...
## - attr(*, ".internal.selfref")=<externalptr>
sapply(covid,FUN = class)
## Region Codigo region Comuna Codigo comuna
## "character" "integer" "character" "integer"
## Poblacion Casos Confirmados
## "numeric" "numeric"
covid[,`Casos Confirmados`:=as.numeric(`Casos Confirmados`)]
# Choropleth maps
library(sf)
library(chilemapas)
help(package='chilemapas')
comunas_rm<-mapa_comunas[mapa_comunas$codigo_region==13,]
comunas_rm<-merge(comunas_rm,covid,by.x="codigo_comuna",by.y="Codigo comuna",all.x=TRUE,sort=F)
# Choropleth plot (continuos scale)
library(RColorBrewer)
paleta <- rev(brewer.pal(n = 5,name = "Reds"))
p_cont<-ggplot(comunas_rm) +
geom_sf(aes(fill = `Casos Confirmados`, geometry = geometry)) +
scale_fill_gradientn(colours = rev(paleta), name = "No. Casos") +
labs(title = "Casos Confirmados", subtitle = "Región Metropolitana - 2020.04.20") +
theme_minimal(base_size = 11)
p_cont
# Choropleth plot (Discrete scale)
## Fixed
library(classInt)
help(package='classInt')
breaks_fixed <- classIntervals(comunas_rm$`Casos Confirmados`, n = 5, style = "fixed", fixedBreaks=c(min(comunas_rm$`Casos Confirmados`,na.rm = T),5,20,50,100,max(comunas_rm$`Casos Confirmados`,na.rm = T)))
comunas_rm$casos_fixed<-cut(comunas_rm$`Casos Confirmados`,breaks = breaks_fixed$brks)
p_fixed<-ggplot(comunas_rm) +
geom_sf(aes(fill = casos_fixed, geometry = geometry)) +
scale_fill_brewer(palette = "Reds")+
labs(title = "Casos Confirmados", subtitle = "Región Metropolitana - 2020.04.20") +
theme_minimal(base_size = 11)
p_fixed
# Equal interval
breaks_equal <- classIntervals(comunas_rm$`Casos Confirmados`, n = 5, style = "equal")
comunas_rm$casos_equal<-cut(comunas_rm$`Casos Confirmados`,breaks = breaks_equal$brks)
p_equal<-ggplot(comunas_rm) +
geom_sf(aes(fill = casos_equal, geometry = geometry)) +
scale_fill_brewer(palette = "Reds")+
labs(title = "Casos Confirmados", subtitle = "Región Metropolitana - 2020.04.20") +
theme_minimal(base_size = 11)
p_equal
# Natural Breaks (Jenks)
breaks_jenks <- classIntervals(comunas_rm$`Casos Confirmados`, n = 5, style = "jenks")
comunas_rm$casos_jenks<-cut(comunas_rm$`Casos Confirmados`,breaks = breaks_jenks$brks)
p_jenks<-ggplot(comunas_rm) +
geom_sf(aes(fill = casos_jenks, geometry = geometry)) +
scale_fill_brewer(palette = "Reds")+
labs(title = "Casos Confirmados", subtitle = "Región Metropolitana - 2020.04.20") +
theme_minimal(base_size = 11)
p_jenks
# Quantile (Equal share)
breaks_quantile <- classIntervals(comunas_rm$`Casos Confirmados`, n = 5, style = "quantile")
comunas_rm$casos_quantile<-cut(comunas_rm$`Casos Confirmados`,breaks = breaks_quantile$brks)
p_quantile<-ggplot(comunas_rm) +
geom_sf(aes(fill = casos_quantile, geometry = geometry)) +
scale_fill_brewer(palette = "Reds")+
labs(title = "Casos Confirmados", subtitle = "Región Metropolitana - 2020.04.20") +
theme_minimal(base_size = 11)
# Standard Deviation
breaks_sd <- classIntervals(comunas_rm$`Casos Confirmados`, n = 5, style = "sd")
comunas_rm$casos_sd<-cut(comunas_rm$`Casos Confirmados`,breaks = breaks_sd$brks)
p_sd<-ggplot(comunas_rm) +
geom_sf(aes(fill = casos_sd, geometry = geometry)) +
scale_fill_brewer(palette = "Reds")+
labs(title = "Casos Confirmados", subtitle = "Región Metropolitana - 2020.04.20") +
theme_minimal(base_size = 11)
p_sd
### looking at everything together
library(gridExtra)
help(package='gridExtra')
grid.arrange(p_cont,p_fixed,p_equal,p_jenks,p_quantile,p_sd)
##### leaflet - Mapeo Dinámico
library(leaflet)
library(sp)
st_crs(comunas_rm)
## Coordinate Reference System:
## No EPSG code
## proj4string: "+proj=longlat +ellps=GRS80 +no_defs"
comunas_rm<-st_transform(comunas_rm,crs = "+proj=longlat +datum=WGS84")
bins <- c(min(comunas_rm$`Casos Confirmados`,na.rm = T),5,20,50,100,max(comunas_rm$`Casos Confirmados`,na.rm = T))
pal <- colorBin("Reds", domain = comunas_rm$`Casos Confirmados`, bins = bins,right = T)
pal_quantile <- colorQuantile("Reds", domain = comunas_rm$`Casos Confirmados`, n = 5)
pal_quantile2<-colorFactor("Reds",domain = comunas_rm$casos_quantile)
names(comunas_rm)
## [1] "codigo_comuna" "codigo_provincia" "codigo_region"
## [4] "Region" "Codigo region" "Comuna"
## [7] "Poblacion" "Casos Confirmados" "geometry"
## [10] "casos_fixed" "casos_equal" "casos_jenks"
## [13] "casos_quantile" "casos_sd"
leaflet(comunas_rm) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addPolygons(fillColor = ~pal(`Casos Confirmados`), weight = 2, fillOpacity = 0.7,group = "Fixed",color=~pal(`Casos Confirmados`)) %>%
addLegend(pal = pal, values = ~`Casos Confirmados`, opacity = 1,position = "bottomright",title = "Fixed",group = "Fixed") %>%
addPolygons(stroke = FALSE, color = ~pal_quantile2(casos_quantile), weight = 2, fillOpacity = 0.7,group = "Quantile") %>%
addLegend(pal = pal_quantile2, values = ~casos_quantile, opacity = 1,position = "bottomright",title = "Quantile",group = "Quantile") %>%
addLayersControl(
overlayGroups = c("Fixed", "Quantile"),
options = layersControlOptions(collapsed = FALSE)
)
Concepts:
Casos Confirmados)comunas_rm$r_i<-comunas_rm$`Casos Confirmados`/comunas_rm$Poblacion
div_pal<-brewer.pal(name = "RdBu",n = 5)
r_cont<-ggplot(comunas_rm) +
geom_sf(aes(fill = r_i, geometry = geometry)) +
scale_fill_gradient2(low = div_pal[5], mid = "white",
high = div_pal[1],name = "Tasa Riesgo") +
labs(title = "Tasa Cruda de Riesgo", subtitle = "Región Metropolitana - 2020.04.20") +
theme_minimal(base_size = 11)
r_cont
comunas_rm$AR<-sum(comunas_rm$`Casos Confirmados`,na.rm = T)/sum(comunas_rm$Poblacion,na.rm = T)
comunas_rm$E_i<-comunas_rm$Poblacion*comunas_rm$AR
comunas_rm$R_i<-comunas_rm$`Casos Confirmados`/comunas_rm$E_i
R_cont<-ggplot(comunas_rm) +
geom_sf(aes(fill = R_i, geometry = geometry)) +
scale_fill_gradient2(low = div_pal[5], mid = "white",
high = div_pal[1],name = "Tasa Relativa",midpoint=1) +
labs(title = "Tasa Relativa de Riesgo", subtitle = "Región Metropolitana - 2020.04.20") +
theme_minimal(base_size = 11)
grid.arrange(r_cont,R_cont,nrow=1)
Conmutación:
# Visualización de la Commutación
ODRM<-readRDS("otros_datos/ConmutacionRM.rds")
class(ODRM)
## [1] "data.table" "data.frame"
names(ODRM)
## [1] "b18_codigo" "r_p_c" "Total"
names(ODRM)<-c("destino",'origen','Total')
library(circlize)
## ========================================
## circlize version 0.4.8
## CRAN page: https://cran.r-project.org/package=circlize
## Github page: https://github.com/jokergoo/circlize
## Documentation: http://jokergoo.github.io/circlize_book/book/
##
## If you use it in published research, please cite:
## Gu, Z. circlize implements and enhances circular visualization
## in R. Bioinformatics 2014.
## ========================================
library(chorddiag)
# Creamos matriz de conmutación, donde las filas representan en qué comuna viven y las columna en que columna trabajan:
MATRIZ_OD_RM <- with(ODRM, tapply(Total, list(destino,origen), FUN=sum))
MATRIZ_OD_RM[is.na(MATRIZ_OD_RM)] <- 0 # Cambiamos NAs de las matrices por 0s.
chorddiag(MATRIZ_OD_RM[-44,], type = "directional")
## Warning in RColorBrewer::brewer.pal(n, palette): n too large, allowed maximum for palette Dark2 is 8
## Returning the palette you asked for with that many colors
# Diferenciando población trabajadora por origen y destino
Trabajadores_origen<-ODRM[,.(Trab_origen=sum(Total,na.rm = T)),by=.(origen)]
Trabajadores_destino<-ODRM[,.(Trab_destino=sum(Total,na.rm = T)),by=.(destino)]
comunas_rm<-merge(comunas_rm,Trabajadores_origen,by.x='codigo_comuna',by.y='origen',all.x=T,sort=F)
comunas_rm<-merge(comunas_rm,Trabajadores_destino,by.x='codigo_comuna',by.y='destino',all.x=T,sort=F)
# Diferencias Poblacionales
# Natural Breaks (Jenks) - Poblacion total
breaks_jenks_t <- classIntervals(comunas_rm$Poblacion, n = 5, style = "jenks")
comunas_rm$pop_jenks<-cut(comunas_rm$Poblacion,breaks = breaks_jenks_t$brks)
pop_jenks<-ggplot(comunas_rm) +
geom_sf(aes(fill = pop_jenks, geometry = geometry)) +
scale_fill_brewer(palette = "YlOrBr")+
labs(title = "Población", subtitle = "Región Metropolitana - 2020.04.20") +
theme_minimal(base_size = 11)
# Natural Breaks (Jenks) - Trabajadores por Origen
breaks_jenks_o <- classIntervals(comunas_rm$Trab_origen, n = 5, style = "jenks")
## Warning in classIntervals(comunas_rm$Trab_origen, n = 5, style = "jenks"): var
## has missing values, omitted in finding classes
comunas_rm$trab_jenks_o<-cut(comunas_rm$Trab_origen,breaks = breaks_jenks_o$brks)
trab_jenks_o<-ggplot(comunas_rm) +
geom_sf(aes(fill = trab_jenks_o, geometry = geometry)) +
scale_fill_brewer(palette = "YlOrBr")+
labs(title = "Trabajadores por Origen", subtitle = "Región Metropolitana - 2020.04.20") +
theme_minimal(base_size = 11)
trab_jenks_o
# Natural Breaks (Jenks) - Trabajadores por Destino
breaks_jenks_d <- classIntervals(comunas_rm$Trab_destino, n = 5, style = "jenks")
comunas_rm$trab_jenks_d<-cut(comunas_rm$Trab_destino,breaks = breaks_jenks_d$brks)
trab_jenks_d<-ggplot(comunas_rm) +
geom_sf(aes(fill = trab_jenks_d, geometry = geometry)) +
scale_fill_brewer(palette = "YlOrBr")+
labs(title = "Trabajadores por Destino", subtitle = "Región Metropolitana - 2020.04.20") +
theme_minimal(base_size = 11)
trab_jenks_d
# Risk by origen
comunas_rm$r_i_TO<-comunas_rm$`Casos Confirmados`/comunas_rm$Trab_origen
comunas_rm$AR_TO<-sum(comunas_rm$`Casos Confirmados`,na.rm = T)/sum(comunas_rm$Trab_origen,na.rm = T)
comunas_rm$E_i_TO<-comunas_rm$Trab_origen*comunas_rm$AR_TO
comunas_rm$R_i_TO<-comunas_rm$`Casos Confirmados`/comunas_rm$E_i_TO
R_cont_TO<-ggplot(comunas_rm) +
geom_sf(aes(fill = R_i_TO, geometry = geometry)) +
scale_fill_gradient2(low = div_pal[5], mid = "white",
high = div_pal[1],name = "Tasa Relativa",midpoint=1) +
labs(title = "Tasa Relativa de Riesgo - Trabajadores Origen", subtitle = "Región Metropolitana - 2020-04-08") +
theme_minimal(base_size = 11)
R_cont_TO
# Risk by destino
comunas_rm$r_i_TD<-comunas_rm$`Casos Confirmados`/comunas_rm$Trab_destino
comunas_rm$AR_TD<-sum(comunas_rm$`Casos Confirmados`,na.rm = T)/sum(comunas_rm$Trab_destino,na.rm = T)
comunas_rm$E_i_TD<-comunas_rm$Trab_destino*comunas_rm$AR_TD
comunas_rm$R_i_TD<-comunas_rm$`Casos Confirmados`/comunas_rm$E_i_TD
R_cont_TD<-ggplot(comunas_rm) +
geom_sf(aes(fill = R_i_TD, geometry = geometry)) +
scale_fill_gradient2(low = div_pal[5], mid = "white",
high = div_pal[1],name = "Tasa Relativa",midpoint=1) +
labs(title = "Tasa Relativa de Riesgo - Trabajadores Destino", subtitle = "Región Metropolitana - 2020-04-08") +
theme_minimal(base_size = 11)
R_cont_TD
Concepto Clave: Mientras más cerca (temporalmente), más información hay en los datos para explicar el presente (y posiblemete el fututo)
#Covid
library(data.table)
archivos<-dir(path = "output/producto2/")
COVID<-fread(input =paste0("output/producto2/",archivos[1]))
names(COVID)[6]<-paste0("Confirmados_",substr(archivos[1],start = 1,stop = 10))
for(i in 2:length(archivos)){
aa<-fread(input =paste0("output/producto2/",archivos[i]))
aa<-aa[,.(`Codigo comuna`,`Casos Confirmados`)]
names(aa)[2]<-paste0("Confirmados_",substr(archivos[i],start = 1,stop = 10))
COVID<-merge(COVID,aa,by="Codigo comuna",all.x=T,sort=F)
}
COVID[is.na(`Confirmados_2020-03-30`),`Confirmados_2020-03-30`:=0]
library(ggplot2)
ggplot(COVID,aes(x=`Confirmados_2020-03-30`,y=`Confirmados_2020-04-20`))+geom_point()+geom_smooth(method = lm)
## Warning: Removed 32 rows containing non-finite values (stat_smooth).
## Warning: Removed 32 rows containing missing values (geom_point).
ggplot(COVID,aes(x=`Confirmados_2020-04-10`,y=`Confirmados_2020-04-20`))+geom_point()+geom_smooth(method = lm)
## Warning: Removed 32 rows containing non-finite values (stat_smooth).
## Warning: Removed 32 rows containing missing values (geom_point).
ggplot(COVID,aes(x=`Confirmados_2020-04-17`,y=`Confirmados_2020-04-20`))+geom_point()+geom_smooth(method = lm)
## Warning: Removed 32 rows containing non-finite values (stat_smooth).
## Warning: Removed 32 rows containing missing values (geom_point).
Conceptos Clave: - Autocorrelación Espacial: Correlación de una variable consigo misma en los valores que toma en otras ubicaciones. - Rezago espacial: promedio de los vecinos de una variable para una unidad espacial
#install.packages("chilemapas")
library(chilemapas)
library(data.table)
library(ggplot2)
comunas_rm<-mapa_comunas[mapa_comunas$codigo_region==13,]
comunas_rm<-merge(x = comunas_rm,y = COVID[`Codigo region`==13,],by.x="codigo_comuna",by.y="Codigo comuna",all.x=TRUE,sort=F)
comunas_rm<-as_Spatial(comunas_rm)
library(spdep)
## Loading required package: Matrix
## Loading required package: spData
## To access larger datasets in this package, install the spDataLarge
## package with: `install.packages('spDataLarge',
## repos='https://nowosad.github.io/drat/', type='source')`
nbs<-poly2nb(comunas_rm,queen = T)
w_rm<-nb2listw(nbs,style = "W")
plot(comunas_rm)
plot(nbs,coordinates(comunas_rm),add=T,col='blue',pch=".")
comunas_rm@data$sl_Confirmados_2020.04.20<-lag.listw(w_rm,comunas_rm$Confirmados_2020.04.20)
comunas_rm<-as(comunas_rm,'sf')
ggplot(comunas_rm,aes(x=Confirmados_2020.04.20, y=sl_Confirmados_2020.04.20))+ geom_point()+geom_smooth(method = 'loess')
# Quantile (Equal share)
breaks_quantile <- classIntervals(comunas_rm$Confirmados_2020.04.20, n = 5, style = "quantile")
comunas_rm$casos_quantile<-cut(comunas_rm$Confirmados_2020.04.20,breaks = breaks_quantile$brks)
p_quantile2<-ggplot(comunas_rm) +
geom_sf(aes(fill = casos_quantile, geometry = geometry)) +
scale_fill_brewer(palette = "Reds")+
labs(title = "Casos Confirmados", subtitle = "Región Metropolitana - 2020.04.20") +
theme_minimal(base_size = 11)
#Spatial Lag
breaks_quantile_sl <- classIntervals(comunas_rm$sl_Confirmados_2020.04.20, n = 5, style = "quantile")
comunas_rm$casos_quantile_sl<-cut(comunas_rm$sl_Confirmados_2020.04.20,breaks = breaks_quantile$brks)
p_quantile_sl<-ggplot(comunas_rm) +
geom_sf(aes(fill = casos_quantile_sl, geometry = geometry)) +
scale_fill_brewer(palette = "Reds")+
labs(title = "Promedio Casos Confirmados Comunas Vecinas", subtitle = "Región Metropolitana - 2020.04.20") +
theme_minimal(base_size = 11)
grid.arrange(p_quantile2,p_quantile_sl,nrow=1)
Esteban López Ochoa: